unit bus.tts;

interface
uses
  System.SysUtils, System.Classes, System.Generics.Collections;

type

  TBusTTS = class(TThread)
  private
    class var
      FInstance: TBusTTS;
  public
    procedure Execute; override;
  private
    FQueue: TQueue<string>;
    procedure SetTTS(const Value: string);
  public
    constructor Create(CreateSuspended: Boolean); overload;
    destructor Destroy; override;

    class function GetInstance: TBusTTS;
    class destructor Destroy;
  public
    property TTS: string write SetTTS;
  end;

implementation
uses
  System.Win.ComObj, Winapi.ActiveX, System.Variants;

{ TBusTTS }

constructor TBusTTS.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  FQueue := TQueue<string>.Create;
end;

destructor TBusTTS.Destroy;
begin
  FQueue.Clear;
  FQueue.Free;
  inherited;
end;

class destructor TBusTTS.Destroy;
begin
  if FInstance <> nil then
    FInstance.Terminate;
//  FreeAndNil(FInstance);
  FInstance := nil;
end;

procedure TBusTTS.Execute;
var
  voice: OLEVariant;
  sTTS: string;
begin
  coInitialize(nil);
  try
    voice := CreateOLEObject('SAPI.SpVoice');
    try
    //      voice.voice := voice.GetVoices('Name=VM Hui').Item(0);
      voice.volume := 100;
      voice.rate := 1;

      while not Terminated do
      begin
        if FQueue.Count > 0 then
        begin
          sTTS := FQueue.Dequeue;

          if not sTTS.IsEmpty then
            voice.Speak(sTTS, 0);
        end;
        Sleep(100);
      end;

    finally
      voice := unassigned;
    end;

  finally
    CoUninitialize;
  end;
end;

class function TBusTTS.GetInstance: TBusTTS;
begin
  if FInstance = nil then
  begin
    FInstance := TBusTTS.Create(True);
    FInstance.FreeOnTerminate := True;
    FInstance.Resume;
  end;
  Result := FInstance;
end;

procedure TBusTTS.SetTTS(const Value: string);
begin
  FQueue.Enqueue(Value);
end;

end.
